home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / parallax / more_exa.tar / more / Graphics / zbuff.p < prev   
Text File  |  1992-01-20  |  30KB  |  946 lines
  1. (***************************************************************************)
  2. (*                                         *)
  3. (*  Pixelparallel Z-Buffer-Algorithm                                       *)
  4. (*                                         *)
  5. (*                                         *)
  6. (*  Author   : Sabine Liebelt                                              *)
  7. (*  File     : zbuff.p                                     *)
  8. (*  Language : Parallaxis                                  *)
  9. (*                                         *)
  10. (***************************************************************************)
  11.  
  12. SYSTEM zbuff;
  13.  
  14. CONST
  15.      Size = 200;                 (*  screensize in pixel           *)
  16.      MaxPoly = 200;             (*  Max. number of polygon       *)
  17.      MaxEdges = 5;             (*  Max. number of corners per poly.*)
  18.      MaxLights = 5;             (*  max. number of lights         *)
  19.      Eps = 0.0001;             (*  Ungenauigkeitsfaktor       *)
  20.  
  21. TYPE
  22.      string = ARRAY [1..50] OF CHAR;
  23.  
  24.      Vec = ARRAY [1..3] OF REAL;     (*  coefficients of one corner    *)
  25.  
  26.      RGB = ARRAY [1..3] OF REAL;     (*  colorvec               *)
  27.  
  28.      Pixel = RECORD             (*  per pixel:               *)
  29.                 x,y : REAL;         (*  coordinates, (0,0) in the center*)
  30.                 z: REAL;             (*  z-value of visible poly.      *)
  31.                 color: RGB;         (*  color of visible poly.        *)
  32.               END (* record *);
  33.  
  34.      PixGrid = ARRAY [1..Size],[1..Size] OF Pixel;
  35.  
  36.      Polygon = RECORD
  37.                         pid: CARDINAL;     (*  unique polynumber             *)
  38.                         a,b,c,d: REAL;     (*  coeffic. of plain, describing *)
  39.                      (*  by the poly                   *)
  40.                         vertices: ARRAY [1..MaxEdges] OF Vec;
  41.                           (*  list of polycorners           *)
  42.                         vcount: INTEGER;     (*  count corners           *)
  43.                         color: RGB;      (*  colorvalue poly            *)
  44.                 END (* record *);
  45.      
  46.      PolyList = ARRAY [1..MaxPoly] OF Polygon;
  47.                       (*  table of polygones               *)
  48.  
  49.      Viewer = RECORD
  50.                         pos: Vec;         (*  point of view           *)
  51.                         at: Vec;         (*  viewing direction           *)
  52.                         up: Vec;         (*  direction above           *)
  53.                         angle: REAL;     (*  view-angle in degree       *)
  54.                END;
  55.  
  56.  
  57.      Light = RECORD
  58.                 pos: Vec;
  59.                 intensity: RGB;
  60.               END;
  61.  
  62.      LightList = ARRAY [1..MaxLights] OF Light;
  63.  
  64.  
  65. CONFIGURATION
  66.      grid [1..Size], [1..Size];
  67.  
  68. CONNECTION;
  69.  
  70. SCALAR
  71.      sin_x, cos_x: REAL;              (*  sinus, cosinus of rotary angle*)
  72.                           (*  around  x - axle           *)
  73.      sin_y, cos_y: REAL;              (*  sinus, cosinus of rotary angle*)
  74.                           (*  around  y - axle           *)
  75.      sin_z, cos_z: REAL;              (*  sinus, cosinus of rotary angle*)
  76.                           (*  around  z - axle           *)
  77.      up: Vec;                 (*  transformated up-vevtor       *)
  78.      interval: REAL;             (*  expansion of pixel         *)
  79.      eye: Viewer;             (*  viewer-data           *)
  80.      lightcount: INTEGER;         (*  lightcounter              *)
  81.      ll: LightList;             (*  lightlist                 *)
  82.      pl: PolyList;             (*  polygone-table           *)
  83.      pg: PixGrid;             (*  array for whole imagesize     *)
  84.      polycount: INTEGER;         (*  counter for polygone       *)
  85.      i,j: INTEGER;             (*  counter                   *)
  86.      hither: REAL;
  87.      amb: RGB;                 (*  ambient light           *)
  88.      background: RGB;             (*  backgroundcolor           *)
  89.      objfile, picfile, inputf:  string;  (*  inputfile                 *)
  90.  
  91. VECTOR
  92.      vpixel: Pixel;
  93.      Vecpoly: Polygon;
  94.      
  95.  
  96.  
  97. PROCEDURE strcat( SCALAR first , second : string ) : SCALAR string ;
  98. (***************************************************************************)
  99. (*  Concatenates two strings                                               *)
  100. (***************************************************************************)
  101.  
  102.   SCALAR
  103.    i , j : INTEGER;
  104.  
  105.   BEGIN
  106.    i := 1 ; j := 1 ;
  107.    WHILE first[i] <> CHR(0) DO INC(i) ; END ; 
  108.    WHILE second[j] <> CHR(0) DO first[i] := second[j] ; INC(j) ; INC(i) ; END ;
  109.    first[i] := CHR(0) ;
  110.  
  111.    RETURN first ;
  112.   END strcat ;
  113.  
  114. (***************************************************************************)
  115.  
  116. PROCEDURE createscene ();
  117. (***************************************************************************)
  118. (*                                         *)
  119. (*  subprocedures:                               *)
  120. (*  get_viewer, get_light, get_background, get_poly,           ,         *)
  121. (*  get_material, Read_comment                               *)
  122. (*                                           *)
  123. (*  global variable:                                                      *)
  124. (*                                                                           *)
  125. (*  function:                                                               *)
  126. (*  read viewer, object and light-data.                                      *)
  127. (*  If no viewer exist, then program will be terminated. If more than one  *)
  128. (*  viewer exist, then the last one would be used.                     *)
  129. (*  The direction of light-rays will be accepted as 'at - lpos'.       *)  
  130. (*                                         *)
  131. (*  Inputfile has to be in NFF-Format :                    *)
  132. (*                                         *)
  133. (*  #  Viewpoint                                *)
  134. (*  v  from  pos_x  pos_y  pos_z                       *)
  135. (*     at    at_x  at_y  at_z                           *)
  136. (*     up    x  y  z                               *)
  137. (*     angle  alpha                               *)
  138. (*     hither dist                               *)
  139. (*     resolution x y                               *)
  140. (*  # Lights                                           *)
  141. (*  l pos_x  pos_y  pos_z  r  g  b                       *)
  142. (*  # Backgroundcolor                               *)
  143. (*  b r  g  b                                   *)
  144. (*  # Material                                   *)
  145. (*  r  g  b  kdr  ksr  shine kst  eta                       *) 
  146. (*  # Polygones                                   *)
  147. (*  P num.Corners x y z  x y z  ...                         *)
  148. (*                                                                          *)
  149. (***************************************************************************)
  150.  
  151. SCALAR
  152.      view: BOOLEAN;             (*  true = viewer known           *)
  153.                       (*  false = viewer still unknown  *)
  154.      back: BOOLEAN;             (*  true = background known       *)
  155.                       (*  false = background still unknown*)
  156.      material: BOOLEAN;             (*  true = surface known          *)
  157.                           (*  false = surface still unknown *)
  158.      mat: RECORD             (*  current material              *)
  159.                 color: RGB;
  160.                 kdr: REAL;
  161.                 ksr: REAL;
  162.                 shine: REAL;
  163.                 kst: REAL;
  164.                 eta: REAL;
  165.            END;
  166.      t: CHAR;                 (*  l = light                    *)
  167.                           (*  p = polygon           *)
  168.                           (*  v = viewer               *)
  169.  
  170.  
  171. PROCEDURE get_viewer();
  172. (***************************************************************************)
  173. (*                                         *)
  174. (*  Calling procedure:                               *)
  175. (*  createscene                                   *)
  176. (*                                                                           *)
  177. (*  global variable:                                                      *)
  178. (*  eye                                       *)
  179. (*                                                                           *)
  180. (*  function:                                                               *)
  181. (*  to read viewerdata from file                                            *)
  182. (*                                                                           *)
  183. (***************************************************************************)
  184.  
  185. SCALAR
  186.      i: INTEGER;             (*  counter                 *)
  187.      next: string;
  188.      resx, resy: INTEGER;
  189.  
  190. BEGIN
  191.      IF view THEN
  192.            WriteString ("WARNING: more than one viewer specified.");
  193.            WriteLn;
  194.            WriteString ("         use last one.");
  195.            WriteLn;
  196.      ELSE
  197.            view := TRUE;
  198.      END;
  199.  
  200.      IF Done THEN
  201.            ReadString (next);
  202.      END;
  203.  
  204.      IF STRCMP (next, "from") = 0 THEN
  205.  
  206. (*  read position                               *)
  207.            i := 1;
  208.            WHILE Done & (i <= 3) DO
  209.                 ReadReal (eye.pos[i]);
  210.                 INC (i);
  211.            END (* while *);
  212.      ELSE
  213.            WriteString ("ERROR: direction of view not correct.");
  214.            HALT;
  215.      END;
  216.  
  217.      IF Done THEN
  218.            ReadString (next);
  219.      END;
  220.  
  221.      IF STRCMP (next, "at") = 0 THEN
  222.  
  223. (*  Blickrichtung einlesen                           *)
  224.            i := 1;
  225.            WHILE Done & (i <= 3) DO
  226.                 ReadReal (eye.at[i]);
  227.                 INC (i);
  228.            END (* while *);
  229.      ELSE
  230.            WriteString ("Fehler in Blickrichtung.");
  231.            HALT;
  232.      END;
  233.  
  234.      IF Done THEN
  235.            ReadString (next);
  236.      END;
  237.  
  238.      IF STRCMP (next, "up") = 0 THEN
  239.  
  240. (*  read direction of view                           *)
  241.            i := 1;
  242.            WHILE Done & (i <= 3) DO
  243.                 ReadReal (eye.up[i]);
  244.                 INC (i);
  245.            END (* while *);
  246.      ELSE
  247.            WriteString ("ERROR: direction of view not correct.");
  248.            HALT;
  249.      END;
  250.  
  251.      IF Done THEN
  252.            ReadString (next);
  253.      END;
  254.  
  255.      IF STRCMP (next, "angle") = 0 THEN
  256.  
  257. (*  read viewing angle                                 *)
  258.            ReadReal (eye.angle);
  259.      ELSE
  260.            WriteString ("ERROR: viewing angle not correct.");
  261.            HALT;
  262.      END;
  263.  
  264.      IF Done THEN
  265.            ReadString (next);
  266.      END;
  267.  
  268.      IF STRCMP (next, "hither") = 0 THEN
  269.  
  270.            ReadReal (hither);
  271.      ELSE
  272.            WriteString ("ERROR: viewerdata not correct.");
  273.            HALT;
  274.      END;
  275.    
  276.      IF Done THEN
  277.            ReadString (next);
  278.      END;
  279.  
  280.      IF STRCMP (next, "resolution") = 0 THEN
  281.  
  282.            ReadInt (resx);
  283.            ReadInt (resy);
  284.      ELSE
  285.            WriteString ("ERROR: viewerdata not correct.");
  286.            HALT;
  287.      END;
  288.  
  289.      IF (resx <> Size) OR (resy <> Size) THEN
  290.            WriteString ("Using default imagesize for resolution.");
  291.            WriteLn;
  292.      END;
  293.      RETURN;
  294.            
  295. END get_viewer;
  296.  
  297.  
  298. PROCEDURE get_light ();
  299. (***************************************************************************)
  300. (*                                         *)
  301. (*  Calling procedure:                               *)
  302. (*  createscene                                   *)
  303. (*                                                                           *)
  304. (*  global variable:                                                      *)
  305. (*  ll                                       *)
  306. (*                                                                           *)
  307. (*  function:                                                               *)
  308. (*  read data of one light.                                    *)
  309. (*                                                                           *)
  310. (***************************************************************************)
  311.  
  312. SCALAR
  313.      i: INTEGER;             (*  counter                 *)
  314.      l: string;
  315.  
  316. BEGIN
  317.  
  318.      IF NOT view THEN
  319.            WriteString ("ERROR: viewer has to be specified before lights.");
  320.            HALT;
  321.      END;
  322.  
  323. (*  increase number of lights and check, if max number is not overcrossed  *)
  324.      INC (lightcount);
  325.      IF (lightcount > MaxLights) THEN
  326.            WriteString ("ERROR: too much lights, maximal");
  327.            WriteInt (MaxLights,2);
  328.            HALT;
  329.      END (* if *);
  330.  
  331. (*  read position                                *)
  332.      i := 1;
  333.      WHILE Done & (i <= 3) DO
  334.            ReadReal (ll[lightcount].pos[i]);
  335.            INC (i);
  336.      END (* while *);
  337.            
  338.      ll[lightcount].pos := rot_xyz (ll[lightcount].pos);
  339.  
  340. (*  read intensity of light                          *)
  341.      i := 1;
  342.      WHILE Done & (i <= 3) DO
  343.            ReadReal (ll[lightcount].intensity[i]);
  344.            INC (i);
  345.      END (* while *);
  346.  
  347.      IF NOT Done THEN
  348.            WriteString ("ERROR: lightdata not correct.");
  349.            HALT;
  350.      END;
  351. END get_light;
  352.  
  353.  
  354. PROCEDURE get_background ();
  355. (***************************************************************************)
  356. (*                                         *)
  357. (*  Calling procedure:                               *)
  358. (*  createscene                                   *)
  359. (*                                                                           *)
  360. (*  global variable:                                                      *)
  361. (*  back                                   *)
  362. (*                                                                           *)
  363. (*  function:                                                               *)
  364. (*  read background data.                                     *)
  365. (*                                                                           *)
  366. (***************************************************************************)
  367.  
  368. SCALAR
  369.      i: INTEGER;             (*  counter                 *)
  370.  
  371. BEGIN
  372.  
  373.      IF back THEN
  374.            WriteString ("WARNING: more than one background-color specified.");
  375.            WriteLn;
  376.            WriteString ("         use last one.");
  377.            WriteLn;
  378.      ELSE
  379.            back := TRUE;
  380.      END;
  381.  
  382.      i := 1;
  383.      WHILE Done & (i <= 3) DO
  384.            ReadReal (background[i]);
  385.            INC (i);
  386.      END (* while *);
  387.  
  388.      IF NOT Done THEN
  389.            WriteString ("ERROR: background-data not correct.");
  390.            HALT;
  391.      END;
  392. END get_background;
  393.  
  394.  
  395. PROCEDURE get_material ();
  396. (***************************************************************************)
  397. (*                                         *)
  398. (*  Calling procedure:                               *)
  399. (*  createscene                                   *)
  400. (*                                                                           *)
  401. (*  global variable:                                                      *)
  402. (*                                                                           *)
  403. (*  function:                                  *)
  404. (*  read surface-data for the following object.                           *)
  405. (*                                                                           *)
  406. (***************************************************************************)
  407.  
  408. BEGIN
  409.      material := TRUE;
  410.      IF Done THEN
  411.            ReadReal (mat.color[1]);
  412.            ReadReal (mat.color[2]);
  413.            ReadReal (mat.color[3]);
  414.            ReadReal (mat.kdr);
  415.            ReadReal (mat.ksr);
  416.            ReadReal (mat.shine);
  417.            ReadReal (mat.kst);
  418.            ReadReal (mat.eta);
  419.      END;
  420.  
  421.      IF NOT Done THEN
  422.            WriteString ("WARNING: surface-description not correct.");
  423.      END;
  424. END get_material;
  425.  
  426.  
  427. PROCEDURE get_poly ();
  428. (***************************************************************************)
  429. (*                                         *)
  430. (*  Calling procedure:                               *)
  431. (*  createscene                                   *)
  432. (*                                                                           *)
  433. (*  global variable:                                                      *)
  434. (*  pl                                       *)
  435. (*                                                                           *)
  436. (*  function:                                                               *)
  437. (*  read polygone-data                                                      *)
  438. (*                                                                           *)
  439. (***************************************************************************)
  440.  
  441. SCALAR
  442.      i: INTEGER;             (*  counter                 *)
  443. BEGIN
  444.      IF NOT view THEN
  445.            WriteString ("ERROR: viewer has to be specified before polygones.");
  446.            HALT;
  447.      END;
  448.  
  449. (* increase number of polygones and check, if max number is not overcrossed*)
  450.      INC (polycount);
  451.      IF (polycount > MaxPoly) THEN
  452.            WriteString ("ERROR: too much polygones, maximal");
  453.            WriteInt (MaxPoly,2);
  454.            HALT;
  455.      END (* if *);
  456.  
  457. (*  read corners of polygones.                           *)
  458.      ReadInt (pl[polycount].vcount);
  459.      i := 1;
  460.      WHILE (i <= pl[polycount].vcount) & Done DO
  461.            ReadReal (pl[polycount].vertices[i][1]);
  462.            ReadReal (pl[polycount].vertices[i][2]);
  463.            ReadReal (pl[polycount].vertices[i][3]);
  464.            pl[polycount].vertices[i] := rot_xyz (pl[polycount].vertices[i]);
  465.            INC (i);
  466.      END (* while *);
  467.  
  468.      IF NOT Done THEN
  469.            WriteString ("ERROR: polygone-data not correct.");
  470.            HALT;
  471.      END;
  472.  
  473.      IF NOT material THEN
  474.            WriteString ("WARNING: no surface-description for object.");
  475.      END;
  476.  
  477.      pl[polycount].color := mat.color;
  478.  
  479. END get_poly;
  480.  
  481.  
  482. PROCEDURE Read_comment ();
  483. (***************************************************************************)
  484. (*                                         *)
  485. (*  Calling procedure:                               *)
  486. (*  createscene                                   *)
  487. (*                                                                           *)
  488. (*  function:                                                               *)
  489. (*  read line untill eoln                           *)
  490. (*                                                                           *)
  491. (***************************************************************************)
  492.  
  493. SCALAR
  494.      c: CHAR;
  495.  
  496. BEGIN
  497.      REPEAT
  498.            Read (c);
  499.      UNTIL (NOT Done) OR (c = EOL);
  500. END Read_comment;
  501.  
  502.  
  503. BEGIN  (* createscene *)
  504.  
  505.      lightcount := 0;
  506.      polycount := 0;
  507.      view := FALSE;
  508.      back := FALSE;
  509.      material := FALSE;
  510.  
  511.      OpenInput (objfile);
  512.      IF (Done) THEN
  513.       Read (t);
  514.      ELSE
  515.            WriteString ("ERROR: can't open inputfile");
  516.            HALT;
  517.      END (* if *);
  518.  
  519.      WHILE (Done) DO
  520.            CASE (CAP(t)) OF
  521.            'V': get_viewer; 
  522.                 compute_transformation;
  523.                 up := rot_xy (eye.up);;
  524.                 sin_z := up[1] / Sqrt (up[1]**2 + up[2]**2);
  525.                 cos_z := up[2] / Sqrt (up[1]**2 + up[2]**2);
  526.                 Read_comment; |
  527.            'L': get_light; 
  528.                 Read_comment; |
  529.            'F': get_material; 
  530.                 Read_comment; |
  531.            'B': get_background; 
  532.                 Read_comment; |
  533.            'S': WriteString ("ERROR: can't calculate spheres.");
  534.                 WriteLn;
  535.                 HALT; |
  536.            'P': get_poly; 
  537.                 Read_comment ;|
  538.            EOL: |
  539.            '#': Read_comment; 
  540.            ELSE
  541.                 WriteString ("ERROR: wrong tag in inputfile.");
  542.                 HALT;
  543.            END;
  544.  
  545.            Read (t);
  546.      END (* while *);
  547.  
  548.      IF NOT back THEN
  549.            background[1] := 0.;
  550.            background[2] := 0.;
  551.            background[3] := 0.;
  552.      END;
  553.  
  554.      IF NOT view THEN
  555.            WriteString ("ERROR: no viewer specified.");
  556.            HALT;
  557.      END;
  558.  
  559.      amb[1] := .035;
  560.      amb[2] := .035;
  561.      amb[3] := .035;
  562.  
  563. END createscene;
  564.  
  565.  
  566. PROCEDURE compute_transformation ();
  567. (***************************************************************************)
  568. (*                                         *)
  569. (*  global variable:                                                      *)
  570. (*  v, eye, sin_x, sin_y, cos_x, cos_y                       *)
  571. (*                                                                           *)
  572. (*  function:                                                               *)
  573. (*  Calculation of helping variables for Image-Transformation              *)
  574. (*                                                                           *)
  575. (***************************************************************************)
  576.  
  577. SCALAR
  578.      length: REAL;             (*  length of viewing ray         *)
  579.      h: REAL;
  580.      v: Vec;                 (*  negative viewing direction    *)
  581.      lup: REAL;                 (*  length of up-vector       *)
  582.  
  583. BEGIN
  584. (*  calculation viewing ray                           *)
  585.      v[1] := eye.pos[1] - eye.at[1];   
  586.      v[2] := eye.pos[2] - eye.at[2];   
  587.      v[3] := eye.pos[3] - eye.at[3];   
  588.      
  589.      length := Sqrt (v[1]**2 + v[2]**2 + v[3]**2);
  590.      v[1] := v[1] / length;
  591.      v[2] := v[2] / length;
  592.      v[3] := v[3] / length;
  593.  
  594. (*  Calculates dieparameter for rotation around x-, y- and z-axle          *)
  595.      h := Sqrt (v[2]**2 + v[3]**2);
  596.      sin_x := v[2] / h;
  597.      cos_x := v[3] / h;
  598.      sin_y := v[1];
  599.      cos_y := h;
  600. END compute_transformation;
  601.  
  602.  
  603. PROCEDURE rot_xyz (SCALAR v1: Vec):SCALAR Vec;
  604. (***************************************************************************)
  605. (*                                         *)
  606. (*  global variable:                                                      *)
  607. (*  sin_x, sin_y, sin_z, cos_x, cos_y, cos_z                   *)
  608. (*                                                                           *)
  609. (*  function:                                                               *)
  610. (*  Transformiert den Punkt v1 in das Sehfeld.                   *)
  611. (*                                                                           *)
  612. (***************************************************************************)
  613.  
  614. SCALAR
  615.      h1, h2, v2: Vec;
  616.  
  617. BEGIN
  618. (*  rotation around x-axle                            *)
  619.      h1[1] := v1[1];
  620.      h1[2] := cos_x * v1[2] - sin_x * v1[3];
  621.      h1[3] := sin_x * v1[2] + cos_x * v1[3];
  622. (*  rotation around y-axle                            *)
  623.      h2[1] := cos_y * h1[1] - sin_y * h1[3];
  624.      h2[2] := h1[2];
  625.      h2[3] := sin_y * h1[1] + cos_y * h1[3];
  626. (*  rotation around z-axle                            *)
  627.      v2[1] := cos_z * h2[1] - sin_z * h2[2];
  628.      v2[2] := sin_z * h2[1] + cos_z * h2[2];
  629.      v2[3] := h2[3];
  630.      RETURN (v2);
  631. END rot_xyz;
  632.  
  633.  
  634. PROCEDURE rot_xy (SCALAR v1: Vec):SCALAR Vec;
  635. (***************************************************************************)
  636. (*                                         *)
  637. (*  global variable:                                                      *)
  638. (*  sin_x, sin_y, sin_z, cos_x, cos_y, cos_z                   *)
  639. (*                                                                           *)
  640. (*  function:                                                               *)
  641. (*  Transformiert den Vektor v1 in das Sehfeld ohne die Richtung von 'up'  *)
  642. (*  zu beruecksichtigen.                                        *)
  643. (*                                                                           *)
  644. (***************************************************************************)
  645.  
  646. SCALAR
  647.      h, v2: Vec;
  648.  
  649. BEGIN
  650. (*  rotation around x-axle                            *)
  651.      h[1] := v1[1];
  652.      h[2] := cos_x * v1[2] - sin_x * v1[3];
  653.      h[3] := sin_x * v1[2] + cos_x * v1[3];
  654. (*  rotation around y-axle                            *)
  655.      v2[1] := cos_y * h[1] - sin_y * h[3];
  656.      v2[2] := h[2];
  657.      v2[3] := sin_y * h[1] + cos_y * h[3];
  658.      RETURN (v2);
  659. END rot_xy;
  660.  
  661.  
  662. PROCEDURE planes ();
  663. (***************************************************************************)
  664. (*                                         *)
  665. (*  global variable:                                                      *)
  666. (*  polycount,pl                               *)
  667. (*  Vecpoly                                                                 *)
  668. (*                                         *)
  669. (*  function:                                                               *)
  670. (*  calculates out of the corners of a polygone the plain-coefficient of   *)
  671. (*  the plain-equation :                                                    *)
  672. (*  ax + by + cz + d = 0                           *)
  673. (*                                                                           *)
  674. (***************************************************************************)
  675.  
  676. VECTOR
  677.      v1, v2: Vec;             (*  edgevec                  *)
  678.      i: INTEGER;             (*  counter                 *)
  679.      r: REAL;
  680.      dot: REAL;
  681.     
  682. BEGIN
  683.      PARALLEL [1..polycount],[1]
  684. (*  calculates out of the first three corners the plain-coefficient        *)
  685.            v1[1] := Vecpoly.vertices[2][1] - Vecpoly.vertices[1][1];
  686.            v1[2] := Vecpoly.vertices[2][2] - Vecpoly.vertices[1][2];
  687.            v1[3] := Vecpoly.vertices[2][3] - Vecpoly.vertices[1][3];
  688.            v2[1] := Vecpoly.vertices[3][1] - Vecpoly.vertices[2][1];
  689.            v2[2] := Vecpoly.vertices[3][2] - Vecpoly.vertices[2][2];
  690.            v2[3] := Vecpoly.vertices[3][3] - Vecpoly.vertices[2][3];
  691.  
  692.            Vecpoly.a := v1[2] * v2[3] - v1[3] * v2[2];
  693.         Vecpoly.b := v2[1] * v1[3] - v2[3] * v1[1];
  694.            Vecpoly.c := v1[1] * v2[2] - v1[2] * v2[1];
  695.            Vecpoly.d := - Vecpoly.a * Vecpoly.vertices [1][1] -
  696.                           Vecpoly.b * Vecpoly.vertices [1][2] - 
  697.                              Vecpoly.c * Vecpoly.vertices [1][3];
  698.  
  699. (*  check, if points represents a plain                      *)
  700.            IF (Vecpoly.a = 0.0) AND (Vecpoly.b = 0.0) AND 
  701.               (Vecpoly.c = 0.0) AND (Vecpoly.d  = 0.0) THEN
  702.                 WriteString ("ERROR: polygonpoints represent no plain");
  703.                 HALT;
  704.       END (* if *);
  705.  
  706. (* in case the area is visible, check whether all other edge points are *)
  707. (* in the same plain *)
  708.       IF Vecpoly.c >=  0. THEN   (* normal is pointing to the front *)
  709.                 i := 4;
  710.                 WHILE i <= Vecpoly.vcount DO
  711.                    IF (ABS(Vecpoly.a*Vecpoly.vertices[i][1] + 
  712.                            Vecpoly.b*Vecpoly.vertices[i][2] + 
  713.                            Vecpoly.c*Vecpoly.vertices[i][3] +
  714.                Vecpoly.d) > .001) THEN
  715.                              WriteString ("ERROR: points represent no plain");
  716.                              HALT;    
  717.                    END (* if *);
  718.                         INC (i);
  719.                 END (* while *);
  720.  
  721. (*  scaling normalvector and adjusting d corresponding.            *)
  722.                 dot := Vecpoly.a**2 + Vecpoly.b**2 + 
  723.                           Vecpoly.c**2;
  724.                 Vecpoly.a := Vecpoly.a / Sqrt (dot);
  725.                 Vecpoly.b := Vecpoly.b / Sqrt (dot);
  726.                 Vecpoly.c := Vecpoly.c / Sqrt (dot);
  727.                 Vecpoly.d := Vecpoly.d / Sqrt(dot);
  728.  
  729.            END;
  730.      ENDPARALLEL;
  731.  
  732. END planes;
  733.  
  734.  
  735. PROCEDURE shade ();
  736. (***************************************************************************)
  737. (*                                         *)
  738. (*  global variable:                                                      *)
  739. (*  Vecpoly                                   *)
  740. (*                                                                           *)
  741. (*  function:                                                               *)
  742. (*  calculate shade of area relative to incoming light.                     *)
  743. (*  The light fall in perpendicular to the (x,y) - plain. That mean, that  *)
  744. (*  the lightvec has the coordinates (0,0,1).                               *) 
  745. (*                                                                           *)
  746. (***************************************************************************)
  747.  
  748. SCALAR
  749.      x: INTEGER;
  750.      i: INTEGER;
  751.      dir: Vec;                 (*  lightvec                 *)
  752.      length: REAL;             (*  length of lightvec          *)
  753.  
  754. VECTOR
  755.      color: RGB;
  756.      mult: REAL;             (*  cosinus of angle between       *)
  757.                       (*  normalvec and incoming light  *)
  758. BEGIN
  759.      PARALLEL
  760.            color := Vecpoly.color;
  761.            Vecpoly.color[1] := 0.;
  762.            Vecpoly.color[2] := 0.;
  763.            Vecpoly.color[3] := 0.;
  764.      ENDPARALLEL;
  765.  
  766.      FOR i := 1 TO lightcount DO
  767.       dir[1] := ll[i].pos[1] - eye.at[1];
  768.            dir[2] := ll[i].pos[2] - eye.at[2];
  769.            dir[3] := ll[i].pos[3] - eye.at[3];
  770.            length := Sqrt (dir[1]**2 + dir[2]**2 + dir[3]**2);
  771.            dir[1] := dir[1] / length;
  772.            dir[2] := dir[2] / length;
  773.            dir[3] := dir[3] / length;
  774.  
  775.            PARALLEL [1..polycount],[1]
  776.                 IF Vecpoly.c > 0. THEN
  777.                         Vecpoly.pid := DIM1;
  778.                         mult := Vecpoly.a*dir[1] + Vecpoly.b*dir[2] + 
  779.                                 Vecpoly.c*dir[3];
  780.                         IF mult > 0. THEN
  781.                              Vecpoly.color[1] := Vecpoly.color[1] + 
  782.                                                   color[1] * mult;
  783.                              Vecpoly.color[2] := Vecpoly.color[2] + 
  784.                                                   color[2] * mult;
  785.                              Vecpoly.color[3] := Vecpoly.color[3] +
  786.                                                   color[3] * mult;
  787.                         END;
  788.                 polycount := REDUCE.SUM (1);
  789.                 x := polycount;
  790.                 STORE (Vecpoly, pl, x);
  791.                 END;
  792.            ENDPARALLEL;
  793.      END;
  794. END shade;
  795.  
  796.  
  797. PROCEDURE pixelkoord ();
  798.      
  799. (***************************************************************************)
  800. (*                                         *)
  801. (*   global variable:                                                      *)
  802. (*   vpixel                                                                  *)
  803. (*   pg                                       *)
  804. (*                                         *)
  805. (*   function:                                                               *)
  806. (*   initialize pixelarray, so that the origin of the coordinate-system    *)
  807. (*   lies in the center.                                                      *)
  808. (*                                                                           *)
  809. (***************************************************************************)
  810.  
  811. SCALAR
  812.      max: REAL;                 (*  absolute value of            *) 
  813.                       (*  marginpoints           *)
  814.  
  815. BEGIN
  816.      max := hither * Tan (eye.angle / 360. * PI);
  817.      interval := 2. * max / FLOAT (Size);
  818.  
  819.      PARALLEL
  820. (*  calculate center of each pixel                       *)
  821.            vpixel.x :=  - max + (FLOAT (DIM2) - .5) *interval;
  822.            vpixel.y :=  max - (FLOAT (DIM1) - .5) *interval;
  823.  
  824. (*  initialize color and depth                                       *)
  825.           vpixel.color:= background;
  826.            vpixel.z := -100000.0;
  827.      ENDPARALLEL;
  828.          
  829. END pixelkoord;
  830.  
  831.  
  832. PROCEDURE pixelcolor (SCALAR p:Polygon);
  833.  
  834. (***************************************************************************)
  835. (*                                         *)
  836. (*  global variable:                                                      *)
  837. (*  vpixel                                   *)
  838. (*                                         *)
  839. (*  function:                                                               *)
  840. (*  calculates the pixel inside the polygone.                                *)
  841. (*  If another polygone is already visible, then the z-values would be     *)
  842. (*  compared and the corresponding color and z-value of foreground polygone*)
  843. (*  would be stored.                                                        *) 
  844. (*                                                                           *)
  845. (***************************************************************************)
  846.  
  847.  
  848. SCALAR
  849.      i: INTEGER;
  850.      v1,v2: Vec;             (*  corners of current edge       *)
  851.      min,max: REAL;             (*  Min and Max of x-coordinates  *)
  852.                       (*  of v1,v2               *)
  853.  
  854. VECTOR
  855.      xs: REAL;                 (*  intersection of current       *)
  856.      znew: REAL;             (*  z-value of pixel in new poly. *)
  857.      inpoly: BOOLEAN;             (*  TRUE, if pixel inside poly.   *)
  858.  
  859. BEGIN     
  860.      inpoly := TRUE;
  861.  
  862.      FOR i := 1 TO p.vcount DO
  863.            IF i = p.vcount THEN
  864.            v2 := p.vertices[1];
  865.            ELSE
  866.                 v2 := p.vertices[i+1];
  867.       END (* if *);
  868.  
  869.            v1 := p.vertices[i];
  870.  
  871.      IF inpoly & 
  872.         ((v1[2] - v2[2]) * vpixel.x + (v2[1] -v1[1]) * vpixel.y +
  873.         (v1[1] * v2[2] - v2[1] * v1[2]) < 0.) THEN
  874.           inpoly := FALSE;
  875.      END (* if *);
  876.  
  877.      END (* for *);
  878.  
  879.      IF inpoly THEN
  880.              IF p.c <> 0.0 THEN
  881.           znew := (-p.d - p.a*vpixel.x - p.b*vpixel.y) / p.c;
  882.                IF znew > vpixel.z THEN
  883.                vpixel.z := znew;
  884.                     vpixel.color := p.color;
  885.           END (* if *);
  886.       END (* if *);
  887.      END (* if *);
  888.            
  889. END pixelcolor;
  890.  
  891.  
  892.  
  893. BEGIN
  894.      (* pixelcolor *)
  895.  
  896.      WriteString ("Objectfile (without extension '.nff') : ");
  897.      ReadString (inputf); 
  898.  
  899.      picfile := strcat( inputf , ".out.ppm" );
  900.      objfile := strcat( inputf , ".nff"     );     
  901.  
  902.      WriteLn;
  903.  
  904.      WriteString ("  Objectfile : " );
  905.      WriteString (objfile); WriteLn;
  906.      WriteString ("  Outputfile : " );
  907.      WriteString (picfile); WriteLn; WriteLn;
  908.  
  909.      createscene;
  910.      LOAD [1..polycount],[1] (Vecpoly, pl);           
  911.      planes;
  912.      shade;
  913.      pixelkoord;
  914.      
  915.      PARALLEL 
  916.            FOR i := 1 TO polycount DO
  917.                 pixelcolor (pl [i]);
  918.            END (* for *);
  919.      ENDPARALLEL;
  920.  
  921.      STORE (vpixel, pg);
  922.      OpenOutput (picfile);
  923.      IF Done THEN
  924.           WriteString ("P6"); WriteLn;
  925.       WriteInt (Size,1); WriteLn;
  926.       WriteInt (Size,1); WriteLn;
  927.            WriteInt (255,1); WriteLn;
  928.      ELSE
  929.            WriteString ("ERROR: can't open inputfile");
  930.            HALT;
  931.      END;
  932.  
  933.      FOR i:= 1 TO Size DO
  934.  
  935.            FOR j := 1 TO Size DO
  936.                 
  937.                 Write (CHR(TRUNC (pg[i, j].color[1] * 255.)));
  938.                 Write (CHR(TRUNC (pg[i, j].color[2] * 255.)));
  939.                 Write (CHR(TRUNC (pg[i, j].color[3] * 255.)));
  940.  
  941.       END (* for *);
  942.      END;
  943.      CloseOutput;
  944. END zbuff.
  945.  
  946.